home *** CD-ROM | disk | FTP | other *** search
/ Enter 2004 January / enter-2004-01.iso / files / maxima-5.9.0.exe / {app} / share / maxima / 5.9.0 / emacs / dbl.el < prev    next >
Encoding:
Text File  |  2003-02-09  |  22.3 KB  |  686 lines
  1. ;; Run gcl,maxima,gdb etc under Emacs all possibly all in one buffer.
  2. ;;  
  3. ;; This file is part of GNU Emacs.
  4. ;; Copyright (C) 1998 William F. Schelter
  5.  
  6. ;; GNU Emacs is distributed in the hope that it will be useful, but
  7. ;; WITHOUT ANY WARRANTY.  No author or distributor accepts responsibility
  8. ;; to anyone for the consequences of using it or for whether it serves
  9. ;; any particular purpose or works at all, unless he says so in writing.
  10. ;; Refer to the GNU Emacs General Public License for full details.
  11.  
  12. ;; Everyone is granted permission to copy, modify and redistribute GNU
  13. ;; Emacs, but only under the conditions described in the GNU Emacs
  14. ;; General Public License.  A copy of this license is supposed to have
  15. ;; been given to you along with GNU Emacs so you can know your rights and
  16. ;; responsibilities.  It should be in a file named COPYING.  Among other
  17. ;; things, the copyright notice and this notice must be preserved on all
  18. ;; copies.
  19.  
  20. ;; Description of DBL interface:
  21.  
  22. ;; A facility is provided for the simultaneous display of the source code
  23. ;; in one window, while using dbl to step through a function in the
  24. ;; other.  A small arrow in the source window, indicates the current
  25. ;; line.
  26.  
  27. ;; Starting up:
  28.  
  29. ;; In order to use this facility, invoke the command DBL to obtain a
  30. ;; shell window with the appropriate command bindings.  You will be asked
  31. ;; for the name of a file to run.  Dbl will be invoked on this file, in a
  32. ;; window named *dbl-foo* if the file is foo.
  33.  
  34. ;; M-s steps by one line, and redisplays the source file and line.
  35.  
  36. ;; You may easily create additional commands and bindings to interact
  37. ;; with the display.  For example to put the dbl command next on \M-n
  38. ;; (def-dbl :next "\M-n")
  39.  
  40. ;; This causes the emacs command dbl-next to be defined, and runs
  41. ;; dbl-display-frame after the command.
  42.  
  43. ;; dbl-display-frame is the basic display function.  It tries to display
  44. ;; in the other window, the file and line corresponding to the current
  45. ;; position in the dbl window.  For example after a dbl-step, it would
  46. ;; display the line corresponding to the position for the last step.  Or
  47. ;; if you have done a backtrace in the dbl buffer, and move the cursor
  48. ;; into one of the frames, it would display the position corresponding to
  49. ;; that frame.
  50.  
  51. ;; dbl-display-frame is invoked automatically when a filename-and-line-number
  52. ;; appears in the output.
  53.  
  54.  
  55. (require 'sshell)
  56. (require 'smart-complete)
  57. (define-key sshell-mode-map "\ep" 'smart-complete)
  58. (define-key sshell-mode-map "\M-p" 'smart-complete)
  59. (require 'gcl)
  60. (autoload 'maxima-mode "maxima-mode" "Major mode for editing maxima code and interacting with debugger" t)
  61. (autoload 'gcl-mode "gcl" "Major mode for editing maxima code and interacting with debugger" t)
  62. (or (rassoc 'maxima-mode auto-mode-alist)
  63. (setq auto-mode-alist (cons '("\\.ma?[cx]\\'" . maxima-mode) auto-mode-alist))
  64. )
  65. (or (rassoc 'gcl-mode auto-mode-alist)
  66. (setq auto-mode-alist (cons '("\\.li?sp\\'" . gcl-mode) auto-mode-alist))
  67. )
  68.  
  69. (defvar dbl-prompt-pattern
  70.    "\\(^\\|\n\\)[^ >]*[>$)%#:][>]*[ ]*"
  71.   ; "(^|\n)\\[^ >]*[>$)%#:][>]*[ ]*+"
  72.   "A regexp to recognize the prompt for dbl or dbl+.")
  73. ;
  74.  
  75. (defvar downcase-filenames-for-dbl
  76.   (string-match "nt[45]" system-configuration)
  77.   "Force the case to be lower when sending a break command" 
  78.   )
  79.  
  80. (defvar dbl-subshell-switches
  81.   (list "bash"  (if (string-match "nt[45]" system-configuration) '("--noediting" "-i")  '("-i"))
  82.     )
  83.   "Alternating list of regexp for the shell name, and list of switches to pass"
  84.   )
  85.  
  86. (defvar dbl-filter-accumulator nil)
  87. (defvar dbl-mode-map nil
  88.   "Keymap for dbl-mode.")
  89.  
  90. (if dbl-mode-map
  91.    nil
  92.   (setq dbl-mode-map (copy-keymap sshell-mode-map))
  93.   (define-key dbl-mode-map "\C-cl" 'dbl-find-and-display-line)
  94.   )
  95.  
  96. (define-key ctl-x-map " " 'dbl-break)
  97. ;(define-key ctl-x-map "&" 'send-dbl-command)
  98.  
  99. ;;Of course you may use `def-dbl' with any other dbl command, including
  100. ;;user defined ones.   
  101.  
  102. (defmacro def-dbl (name key &optional doc)
  103.   (let* ((fun (intern (format "dbl-%s" (read name))))
  104.      )
  105.     (list 'progn
  106.        (list 'defun fun '(arg)
  107.         (or doc "")
  108.         '(interactive "p")
  109.         (list 'dbl-call name 'arg))
  110.       (list 'define-key 'dbl-mode-map key  (list 'quote fun)))))
  111.  
  112. (def-dbl ":step %p"   "\M-s" "Step one source line with display")
  113. (def-dbl ":step %p"   "\C-c\C-s" "Step one source line with display")
  114. (def-dbl ":stepi %p"  "\C-c\t" "Step one instruction with display")
  115. (def-dbl ":next %p"   "\M-n" "Step one source line (skip functions)")
  116. (def-dbl ":next %p"   "\C-c\C-n" "Step one source line (skip functions)")
  117. (def-dbl ":r"   "\M-c" "Continue with display")
  118.  
  119. (def-dbl ":finish" "\C-c\C-f" "Finish executing current function")
  120. (def-dbl ":up %p"     "\C-cu"   "Go up N stack frames (numeric arg) with display")
  121. (def-dbl ":down %p"   "\C-cd"   "Go down N stack frames (numeric arg) with display")
  122.  
  123.  
  124. (defun dbl-mode ()
  125.   "Major mode for interacting with an inferior Lisp or Maxima process.
  126. It is like an ordinary shell, except that it understands certain special
  127. redisplay commands sent by the process, such as redisplay a source file
  128. in the other window, positioning a little arrow `==>', at a certain
  129. line, typically the line where you are stopped in the debugger.
  130.  
  131. It uses completion based on the form of your current prompt, allowing
  132. you to keep separate the commands you type at the debugger level and
  133. the lisp or maxima level.
  134.  
  135. The source files should be viewed using gcl mode for lisp, and maxima-mode
  136. for maxima.  
  137.  
  138.  
  139. \\{dbl-mode-map}
  140.  
  141. \\[dbl-display-frame] displays in the other window
  142. the last line referred to in the dbl buffer.
  143.  
  144. \\[dbl-:step] and \\[dbl-:next] in the dbl window,
  145. call dbl to step and next and then update the other window
  146. with the current file and position.
  147. o
  148. If you are in a source file, you may select a point to break
  149. at, by doing \\[dbl-break].
  150.  
  151. Commands:
  152. Many commands are inherited from shell mode. 
  153. Additionally we have:
  154.  
  155. \\[dbl-display-frame] display frames file in other window
  156. \\[dbl-:step] advance one line in program
  157. \\[dbl-:next] advance one line in program (skip over calls).
  158. \\[send-dbl-command] used for special printing of an arg at the current point.
  159. C-x SPACE sets break point at current line.
  160.  
  161. You may also enter keyword break commands.
  162.  
  163. :a  show-break-variables
  164. :b  simple-backtrace
  165. :bds  break-bds
  166. :bl  break-locals
  167. :blocks  break-blocks
  168. :break  insert a break point here
  169. :bs  break-backward-search-stack
  170. :bt  dbl-backtrace
  171. :c  break-current
  172. :delete  (lambda (&rest l) (iterate-over-bkpts l delete) (values))
  173. :disable  [n1 .. nk] disable break points. [see :info :bkpt]
  174. :down [n]  move n frames down
  175. :enable  [n1 n2 ..nk] enable break points
  176. :env  describe-environment
  177. :fr  [n] show this frame
  178. :fs  break-forward-search-stack
  179. :functions  break-functions
  180. :go  break-go
  181. :h  break-help
  182. :help  break-help
  183. :ihs  ihs-backtrace
  184. :info :bkpt show break points.
  185. :loc  loc
  186. :m  break-message
  187. :n  break-next
  188. :next  step-next
  189. :p  break-previous
  190. :q  break-quit
  191. :r  resume
  192. :resume  (lambda () resume)
  193. :s  search-stack
  194. :step  step-into
  195. :t  throw-macsyma-top
  196. :up  move up one frame
  197. :vs  break-vs
  198.  
  199. "
  200.   (interactive)
  201.   (kill-all-local-variables)
  202.   (setq major-mode 'dbl-mode)
  203.   (setq mode-name "Inferior Dbl")
  204.   (setq mode-line-process '(": %s"))
  205.   (use-local-map dbl-mode-map)
  206.   (make-local-variable 'last-input-start)
  207.   (setq last-input-start (make-marker))
  208.   (make-local-variable 'last-input-end)
  209.   (setq last-input-end (make-marker))
  210.   (make-local-variable 'dbl-last-frame)
  211.   (setq dbl-last-frame nil)
  212.   (make-local-variable 'dbl-last-frame-displayed-p)
  213.   (setq dbl-last-frame-displayed-p t)
  214.   (make-local-variable 'dbl-delete-prompt-marker)
  215.   (setq dbl-delete-prompt-marker nil)
  216.   (make-local-variable 'dbl-filter-accumulator)
  217.   (setq dbl-filter-accumulator nil)
  218.   (make-local-variable 'shell-prompt-pattern)
  219.   (setq shell-prompt-pattern dbl-prompt-pattern)
  220.   (run-hooks 'sshell-mode-hook 'dbl-mode-hook))
  221.  
  222. (defvar current-dbl-buffer nil)
  223.  
  224. (defvar dbl-command-name (if (file-exists-p "/bin/bash") "/bin/bash"
  225.                "/bin/sh")
  226.   "Pathname for executing dbl.")
  227.  
  228.  
  229. (defun dbl (p)
  230.  
  231.  "Makes a dbl buffer, suitable for running an inferior
  232.   gcl.  You are prompted for a name for the buffer.  After the shell
  233.   starts you should start up your lisp program (eg gcl).  The bufferd
  234.   has special keybindings for stepping and viewing sources.  Enter the
  235.   debug loop with (si::dbl) or :dbl in a debug loop.  "
  236.  
  237.   (interactive "p")
  238.   
  239.   (let ( tem
  240.     (dir default-directory)
  241.     ;; important for winnt version of emacs
  242.     (binary-process-input t)
  243.     (binary-process-output nil)
  244.     switches
  245.     (name (concat "dbl" (if (equal p 1) "" p) ""))
  246.     )
  247.     
  248.     (switch-to-buffer (concat "*" name "*"))
  249.     (or (bolp) (newline))
  250.     (insert "Current directory is " default-directory "\n")
  251.     (let ((tem dbl-subshell-switches) switches)
  252.       (while tem
  253.     (cond ((string-match (car tem) dbl-command-name)
  254.            (setq switches (nth 1 tem)) (setq tem nil))
  255.           (t (setq tem (nthcdr 2 tem)))))
  256.       (apply 'make-sshell name dbl-command-name nil switches))
  257.     (dbl-mode)
  258.     (make-local-variable 'sshell-prompt-pattern)
  259.     (setq sshell-prompt-pattern dbl-prompt-pattern)
  260.     (goto-char (point-min))
  261.     (insert "
  262. Welcome to DBL a Debugger for Lisp, Maxima, Gdb and others.
  263.  
  264. You start your program as usually would in a shell.  For Lisp and
  265. Maxima the debugger commands begin with a ':', and there is
  266. completion.  Typing ':' should list all the commands.  In GCL these
  267. are typed when in the debugger, and in Maxima they may be typed at any
  268. time.  To see the wonderful benefits of this mode, type C-h m.
  269.  
  270. Note you may also use this mode to run gdb.  In fact I often debug
  271. MAXIMA over GCL using gdb, thus having three debuggers at once.
  272. To run gdb and enable the automatic line display, you must supply
  273. the `--fullname' keyword as in:
  274.  
  275.  gdb your-file  --fullname
  276. ")
  277.     (goto-char (point-max))
  278.     (set-process-filter (get-buffer-process (current-buffer)) 'dbl-filter)
  279.     (set-process-sentinel (get-buffer-process (current-buffer)) 'dbl-sentinel)
  280.     (dbl-set-buffer)))
  281.  
  282. (defun dbl-set-buffer ()
  283.   (cond ((eq major-mode 'dbl-mode)
  284.     (setq current-dbl-buffer (current-buffer)))))
  285.  
  286. ;; This function is responsible for inserting output from DBL
  287. ;; into the buffer.
  288. ;; Aside from inserting the text, it notices and deletes
  289. ;; each filename-and-line-number;
  290. ;; that DBL prints to identify the selected frame.
  291. ;; It records the filename and line number, and maybe displays that file.
  292. (defun dbl-filter (proc string)
  293.   (let ((inhibit-quit t))
  294.     (set-buffer (process-buffer proc))
  295.     (goto-char (point-max))
  296.     (insert string)
  297.     (goto-char (point-max))
  298.     ))
  299.  
  300.  
  301. (defun dbl-filter (proc string)
  302.   (let ((inhibit-quit t))
  303.     (if dbl-filter-accumulator
  304.     (dbl-filter-accumulate-marker proc
  305.                       (concat dbl-filter-accumulator string))
  306.     (dbl-filter-scan-input proc string))
  307.     ))
  308.  
  309.  
  310. (defun dbl-filter-accumulate-marker (proc string)
  311.   (setq dbl-filter-accumulator nil)
  312.   (if (> (length string) 1)
  313.       (if (= (aref string 1) ?\032)
  314.       (let ((end (string-match "\n" string)))
  315.         (if end
  316.               (progn
  317.         (setq me string)
  318.         (cond ((string-match
  319.             "\032\032\\([A-Za-z]?:?[^:]*\\):\\([0-9]*\\):[^\n]+\n"
  320.             string)
  321.                (setq dbl-last-frame
  322.                   (cons
  323.                   (match-string 1 string)
  324.                   (string-to-int  (match-string 2 string))))
  325.                
  326.                (cond ((equal (cdr dbl-last-frame)  0)
  327.                   ;(message "got 0")
  328.                   ;(sit-for 1)
  329.                   (setq overlay-arrow-position nil)
  330.                   (setq     dbl-last-frame nil)
  331.                  )
  332.                  (t   (setq dbl-last-frame-displayed-p nil))
  333.                )))
  334.  
  335.           (dbl-filter-scan-input proc
  336.                      (substring string (1+ end))))
  337.           (setq dbl-filter-accumulator string)))
  338.     (dbl-filter-insert proc "\032")
  339.     (dbl-filter-scan-input proc (substring string 1)))
  340.     (setq dbl-filter-accumulator string)))
  341.  
  342. (defun dbl-filter-scan-input (proc string)
  343.   (if (equal string "")
  344.       (setq dbl-filter-accumulator nil)
  345.       (let ((start (string-match "\032" string)))
  346.     (if start
  347.         (progn
  348.           ;; to do fix this so that if dbl-last-frame
  349.           ;; changed, then set the current  text property..
  350.           ;;
  351.         (dbl-filter-insert proc (substring string 0 start))
  352.         
  353.         (dbl-filter-accumulate-marker proc
  354.                          (substring string start))
  355.         )
  356.         (dbl-filter-insert proc string)))))
  357.  
  358. (defun dbl-filter-insert (proc string)
  359.   (let (moving
  360.     output-after-point 
  361.     (old-buffer (current-buffer))
  362.     start)
  363.     (set-buffer (process-buffer proc))
  364.     ;; test to see if we will move the point.   We want that the
  365.     ;; window-point of the buffer, should be equal to process-mark. 
  366.     (setq moving (>= (window-point (get-buffer-window (process-buffer proc)))
  367.              (- (process-mark proc) 0)))
  368.     (setq output-after-point (< (point) (process-mark proc)))
  369.     (unwind-protect
  370.     (save-excursion
  371.       ;; Insert the text, moving the process-marker.
  372.       (goto-char (process-mark proc))
  373.       (setq start (point))
  374.       (insert string)
  375.       (set-marker (process-mark proc) (point))
  376.      ; (setq bill (cons (list 'hi (process-mark proc) (marker-position (process-mark proc)) (point)) bill))
  377.       (dbl-maybe-delete-prompt)
  378.       ;; Check for a filename-and-line number.
  379.       (dbl-display-frame
  380.        ;; Don't display the specified file
  381.        ;; unless (1) point is at or after the position where output appears
  382.        ;; and (2) this buffer is on the screen.
  383.        (or output-after-point
  384.            (not (get-buffer-window (current-buffer))))
  385.        ;; Display a file only when a new filename-and-line-number appears.
  386.        t)
  387.       )
  388.       (if moving
  389.       (set-window-point
  390.        (get-buffer-window (process-buffer proc))
  391.        (process-mark proc)))
  392.       (set-buffer old-buffer))
  393.     ))
  394.  
  395. (defun dbl-sentinel (proc msg)
  396.   (cond ((null (buffer-name (process-buffer proc)))
  397.      ;; buffer killed
  398.      ;; Stop displaying an arrow in a source file.
  399.      (setq overlay-arrow-position nil)
  400.      (set-process-buffer proc nil))
  401.     ((memq (process-status proc) '(signal exit))
  402.      ;; Stop displaying an arrow in a source file.
  403.      (setq overlay-arrow-position nil)
  404.      ;; Fix the mode line.
  405.      (setq mode-line-process
  406.            (concat ": "
  407.                (symbol-name (process-status proc))))
  408.      (let* ((obuf (current-buffer)))
  409.        ;; save-excursion isn't the right thing if
  410.        ;;  process-buffer is current-buffer
  411.        (unwind-protect
  412.            (progn
  413.          ;; Write something in *compilation* and hack its mode line,
  414.          (set-buffer (process-buffer proc))
  415.          ;; Force mode line redisplay soon
  416.          (set-buffer-modified-p (buffer-modified-p))
  417.          (if (eobp)
  418.              (insert ?\n mode-name " " msg)
  419.            (save-excursion
  420.              (goto-char (point-max))
  421.              (insert ?\n mode-name " " msg)))
  422.          ;; If buffer and mode line will show that the process
  423.          ;; is dead, we can delete it now.  Otherwise it
  424.          ;; will stay around until M-x list-processes.
  425.          (delete-process proc))
  426.          ;; Restore old buffer, but don't restore old point
  427.          ;; if obuf is the dbl buffer.
  428.          (set-buffer obuf))))))
  429.  
  430.  
  431. (defun dbl-refresh ()
  432.   "Fix up a possibly garbled display, and redraw the arrow."
  433.   (interactive)
  434.   (redraw-display)
  435.   (dbl-display-frame))
  436.  
  437. (defun dbl-display-frame (&optional nodisplay noauto)
  438.   "Find, obey and delete the last filename-and-line marker from DBL.
  439. The marker looks like \\032\\032FILENAME:LINE:CHARPOS\\n.
  440. Obeying it means displaying in another window the specified file and line."
  441.   (interactive)
  442.   (dbl-set-buffer)
  443.   (and dbl-last-frame (not nodisplay)
  444.        (or (not dbl-last-frame-displayed-p) (not noauto))
  445.        (progn (dbl-display-line (car dbl-last-frame) (cdr dbl-last-frame))
  446.           (setq dbl-last-frame-displayed-p t))))
  447.  
  448.          
  449. ;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen
  450. ;; and that its line LINE is visible.
  451. ;; Put the overlay-arrow on the line LINE in that buffer.
  452.  
  453.  
  454.  
  455. (defun dbl-find-file (file)
  456.   (cond ((file-exists-p file)
  457.      (find-file-noselect file))
  458.     ((get-buffer file))
  459.     (t (find-file-noselect file))))
  460.  
  461. (defvar dbl-dirs  nil)
  462.  
  463. (defun search-path (file dirs)
  464.   (let ((paths (symbol-value dirs))
  465.     true-file)
  466.     (cond ((file-exists-p file) (setq true-file file))
  467.       (t
  468.        (while paths
  469.          (let ((tem (expand-file-name file (or (car paths) default-directory))))
  470.            (if  (file-exists-p tem) (setq true-file tem))
  471.            (setq paths (cdr paths))))))
  472.    
  473.    (cond (true-file)
  474.      (t (setq paths (symbol-value dirs))
  475.       (set dirs
  476.           (append paths
  477.               (list (file-name-directory
  478.                  (read-file-name
  479.                   (format "%s = %s, add path :" dirs paths))))))
  480.          (search-path file dirs)))))
  481.  
  482.  
  483. (defun dbl-find-line ()
  484.   "If the current buffer has a process, then look first for a file-line
  485. property, and if none, then search for a regexp.
  486. If a non process buffer, just return current file and line number.
  487. "
  488.   (interactive)
  489.   (save-excursion
  490.     (end-of-line)
  491.     (cond ((get-buffer-process (current-buffer))
  492.        (cond
  493.         ((save-excursion
  494.            (beginning-of-line)
  495.         (get-text-property (point) 'file-line)))
  496.         ((progn (end-of-line) (re-search-backward " \\([^: ]+\\):\\([0-9]+\\)" 300 nil))
  497.          (setq file (buffer-substring (match-beginning 1) (match-end 1)))
  498.          (setq line (buffer-substring (match-beginning 2) (match-end 2)))
  499.          (setq line (read line))
  500.          (and (integerp line)
  501.           (setq file (search-path file 'dbl-dirs))
  502.           (list file line)))))
  503.       (t (list (buffer-file-name) (+ 1 (count-lines (point))))))))
  504.  
  505. (defun dbl-find-and-display-line ()
  506.   (interactive)
  507.   (let ((res (dbl-find-line)))
  508.     (and res (apply 'dbl-display-line res))))
  509.  
  510. (defun dbl-display-line (true-file line)
  511.   (let* ((buffer (dbl-find-file true-file))
  512.      (window (display-buffer buffer t))
  513.      (pos))
  514.     (save-excursion
  515.       (set-buffer buffer)
  516.       (save-restriction
  517.     (widen)
  518.     (goto-line line)
  519.     (setq pos (point))
  520.     (setq overlay-arrow-string "=>")
  521.     (or overlay-arrow-position
  522.         (setq overlay-arrow-position (make-marker)))
  523.     (set-marker overlay-arrow-position (point) (current-buffer)))
  524.       (cond ((or (< pos (point-min)) (> pos (point-max)))
  525.          (widen)
  526.          (goto-char pos))))
  527.     (set-window-point window overlay-arrow-position)))
  528.  
  529. (defvar dbl-gdb-command-alist '((":step %p" . "step %p")
  530.                 (":next %p" . "next %p")
  531.                 (":stepi" . "stepi %p")
  532.                 (":r" . "r")
  533.                 (":finish" . "finish")
  534.                 (":up %p" . "up %p")
  535.                 ( ":down %p" . "down %p")))
  536.  
  537. (defun dbl-call (command numeric)
  538.   "Invoke dbl COMMAND displaying source in other window."
  539.   (interactive)
  540.   (save-excursion
  541.     (goto-char (point-max))
  542.     (beginning-of-line)
  543.     (let (com)
  544.       (cond ((or (looking-at "(gdb")
  545.          (member major-mode '(c-mode c++-mode)))
  546.          (if (setq com (assoc  command dbl-gdb-command-alist))
  547.          (setq command (cdr com))))))
  548.  
  549.     
  550.         ;; to do put in hook here to recognize whether at
  551.         ;; maxima or lisp level.
  552.  
  553.   (setq command (dbl-subtitute-% command numeric))
  554.   (goto-char (point-max))
  555.   (setq dbl-delete-prompt-marker (point-marker))
  556.   (dbl-set-buffer)
  557.   (send-string (get-buffer-process current-dbl-buffer)
  558.            (concat command "\n"))))
  559.  
  560. (defun dbl-subtitute-% (command n)
  561.   (let* (result
  562.     (in-dbl (get-buffer-process (current-buffer)))
  563.     file-line 
  564.     )
  565.     (cond ((string-match "%[fl]" command)
  566.        (cond (in-dbl (setq file-line (dbl-find-line)))
  567.          (t (setq file-line
  568.               (list (buffer-file-name)
  569.                 (+ 1 (count-lines
  570.                              (point)))))))))
  571.     (while (and command (string-match "\\([^%]*\\)%\\([adeflp]\\)" command))
  572.       (let ((letter (string-to-char (substring command (match-beginning 2))))
  573.         subst)
  574.     (cond ((eq letter ?p)
  575.            (setq subst (if n (int-to-string n) "")))
  576.           ((eq letter ?f)
  577.            (setq subst (or (car file-line) "unknown-file")))
  578.           ((eq letter ?l)
  579.            (setq subst (if (cadr file-line)
  580.                    (int-to-string (cadr file-line))
  581.                    "unknown-line")))
  582.           ((eq letter ?a)
  583.            (setq subst (dbl-read-address))))
  584.     (setq result (concat result
  585.                  (substring command (match-beginning 1) (match-end 1))
  586.                  subst)))
  587.       (setq command (substring command (match-end 2))))
  588.     (concat result command)))
  589.  
  590.  
  591.  
  592. (defun dbl-maybe-delete-prompt ()
  593.   (if (and dbl-delete-prompt-marker
  594.        (> (point-max) (marker-position dbl-delete-prompt-marker)))
  595.       (let (start)
  596.     (goto-char dbl-delete-prompt-marker)
  597.     (setq start (point))
  598.     (beginning-of-line)
  599.     (delete-region (point) start)
  600.     (setq dbl-delete-prompt-marker nil))))
  601.  
  602. (defun dbl-break ()
  603.   "Set DBL breakpoint at this source line."
  604.   (interactive)
  605.   (cond ((eq major-mode 'lisp-mode)
  606.      (save-excursion
  607.        (end-of-line)
  608.        (let (name
  609.          at where)
  610.          (setq where (point))
  611.          (mark-defun)
  612.          (search-forward "(def")
  613.          (forward-sexp 2)
  614.          (setq at (point))
  615.          (forward-sexp -1)
  616.          (setq name (buffer-substring (point) at))
  617.          (beginning-of-line)
  618.          (setq name (format "(si::break-function '%s %s t)"  name (count-lines 1 where)))
  619.          (other-window 1)
  620.          (if (get-buffer-process (current-buffer))
  621.          (setq current-dbl-buffer (current-buffer)))
  622.          (message name)
  623.          (send-string (get-buffer-process current-dbl-buffer)
  624.               (concat name "\n"))
  625.          (other-window 1)
  626.          )))
  627.     (t
  628.   
  629.      (let ((file-name (file-name-nondirectory buffer-file-name))
  630.            (line (save-restriction
  631.                (widen)
  632.                (1+ (count-lines 1 (point))))))
  633.        (and    downcase-filenames-for-dbl
  634.            (setq file-name (downcase file-name)))
  635.        (send-string (get-buffer-process current-dbl-buffer)
  636.             (concat "break " file-name ":" line "\n"))))))
  637.     
  638.     
  639. (defun dbl-read-address()
  640.   "Return a string containing the core-address found in the buffer at point."
  641.   (save-excursion
  642.    (let ((pt (dot)) found begin)
  643.      (setq found (if (search-backward "0x" (- pt 7) t)(dot)))
  644.      (cond (found (forward-char 2)(setq result
  645.             (buffer-substring found
  646.                  (progn (re-search-forward "[^0-9a-f]")
  647.                     (forward-char -1)
  648.                     (dot)))))
  649.        (t (setq begin (progn (re-search-backward "[^0-9]") (forward-char 1)
  650.                  (dot)))
  651.           (forward-char 1)
  652.           (re-search-forward "[^0-9]")
  653.           (forward-char -1)
  654.           (buffer-substring begin (dot)))))))
  655.  
  656.  
  657. (defvar dbl-commands nil
  658.   "List of strings or functions used by send-dbl-command.
  659. It is for customization by you.")
  660.  
  661. (defun send-dbl-command (arg)
  662.  
  663.   "This command reads the number where the cursor is positioned.  It
  664.  then inserts this ADDR at the end of the dbl buffer.  A numeric arg
  665.  selects the ARG'th member COMMAND of the list dbl-print-command.  If
  666.  COMMAND is a string, (format COMMAND ADDR) is inserted, otherwise
  667.  (funcall COMMAND ADDR) is inserted.  eg. \"p (rtx)%s->fld[0].rtint\"
  668.  is a possible string to be a member of dbl-commands.  "
  669.  
  670.  
  671.   (interactive "P")
  672.   (let (comm addr)
  673.     (if arg (setq comm (nth arg dbl-commands)))
  674.     (setq addr (dbl-read-address))
  675.     (if (eq (current-buffer) current-dbl-buffer)
  676.     (set-mark (point)))
  677.     (cond (comm
  678.        (setq comm
  679.          (if (stringp comm) (format comm addr) (funcall comm addr))))
  680.       (t (setq comm addr)))
  681.     (switch-to-buffer current-dbl-buffer)
  682.     (goto-char (dot-max))
  683.     (insert-string comm)))
  684.  
  685. (provide 'dbl)
  686.